unit uxCtrls;

interface

uses
Windows, Classes, Controls, StdCtrls, ExtCtrls, Graphics, GraphUtil, Messages,
SysUtils, Math, Character, Types, pngimage;

//------------------------------------------------------------------------------
type

//** TLabelEx **//
TLabelEx = class(TLabel)
private
  FPadding: Integer;
  procedure SetPadding(Value: Integer);
protected
  procedure AdjustBounds; override;
  procedure Paint; override;
public
  constructor Create(AOwner: TComponent); override;
published
  (* Custom Properties *)
  property Padding: Integer read FPadding write SetPadding default 6;
end;

//------------------------------------------------------------------------------
//** TButtonEx **//
TButtonEx = class(TCustomButton)
private
  FLumA: Integer;
  FLumB: Integer;
  IsDefault: Boolean;
  MouseInControl: Boolean;
  procedure SetBorderColor(Value: TColor);
  procedure SetFocusRectColor(Value: TColor);
  procedure SetLum(Index: Integer; Value: Integer);
protected
  FBorderColor: TColor;
  FCanvas: TCanvas;
  FFocusRectColor: TColor;
  procedure CreateParams(var Params: TCreateParams); override;
  procedure DrawItem(const DrawItemStruct: TDrawItemStruct); virtual;
  procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  procedure SetButtonStyle(ADefault: Boolean); override;
  procedure CMEnabledchanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  procedure CMMouseenter(var Message: TMessage); message CM_MOUSEENTER;
  procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;
  procedure CNDrawitem(var Message: TWMDrawItem); message CN_DRAWITEM;
  procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
      message WM_LBUTTONDBLCLK;
  procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  property Anchors;
  property Caption;
  property Color;
  property Default;
  property DoubleBuffered;
  property Enabled;
  property Font;
  property ParentColor;
  property ParentDoubleBuffered;
  property ParentFont;
  property TabOrder;
  property TabStop;
  property OnClick;
  (* Custom Properties *)
  property BorderColor: TColor
      read FBorderColor write SetBorderColor default clBtnShadow;
  property FocusRectColor: TColor
      read FFocusRectColor write SetFocusRectColor default clBtnShadow;
  property LumA: Integer index 0 read FLumA write SetLum default 10;
  property LumB: Integer index 1 read FLumB write SetLum default -10;
end;

//------------------------------------------------------------------------------
//** TPngButton **//
TPngButton = class(TButtonEx)
private
  FPng: TPngImage;
  FRes: String;
  procedure LoadRes;
  procedure SetRes(Value: String);
protected
  procedure DrawItem(const DrawItemStruct: tagDRAWITEMSTRUCT); override;
  procedure CMEnabledchanged(var Message: TMessage); override;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
published
  (* Custom Properties *)
  property Resource: String read FRes write SetRes;
    // ResourceName_D => Disabled Image
end;

//------------------------------------------------------------------------------
//** THexView **//
THexView = class(TCustomControl)
private const
  PANE_HEX  = 1;
  PANE_CHR  = 2;
private type
  TGetGridFunc = function(X, Y: Integer): TPoint of object;
  TSelectRows = record
    A, B: Integer;
  end;
public type
  TSelectionChangedEvent = procedure(Sender: TObject;
      SelStart, SelLength: Integer) of object;
private
  FData: array of Byte;
  FCapacity: Integer;
  FInitialSize: Integer;
  FCount: Integer;
  FRowCount: Integer;
  FHzOfsRect: TRect;
  FVtOfsRect: TRect;
  FHexRect: TRect;
  FChrRect: TRect;
  FTopRow: Integer;
  FMaxTopRow: Integer;
  FColPerRow: Integer;
  FRowPerpage: Integer;
  FPageWidth: Integer;
  FPageHeight: Integer;
  FActivePane: Integer;
  FCw: Integer;
  FBw: Integer;
  FCh: Integer;
  FCurOfs: Integer;
  FSelStart: Integer;
  FSelLen: Integer;
  FSelecting: Boolean;
  FOnSelectionChanged: TSelectionChangedEvent;
  FHighlight: TColor;
  FHighlightText: TColor;
  FOfsTextColor: TColor;
  FHexStr: array [0..255] of String;
  FChrStr: array [0..255] of String;
  FGrid: TPoint;
  FTimer: TTimer;
  GetGrid: TGetGridFunc;
  FCanScroll: Boolean;
  FReselect: Boolean;
  procedure CreateStrTable;
  function GetActivePane(X, Y: Integer): Integer;
  function GetHexGrid(X, Y: Integer): TPoint;
  function GetChrGrid(X, Y: Integer): TPoint;
  procedure InitFont;
  procedure InitTimer;
  procedure DoSelect;
  function GetSelectRows: TSelectRows;
  function IsSelect(Ofs: Integer; out SelStart: Integer;
      out SelEnd: Integer): Boolean;
  function Select(Ofs: Integer): Boolean;
  function SelectTo(Ofs: Integer): Boolean;
  procedure SetSelection(Ofs: Integer; Shift: Boolean);
  procedure UpdateSelection(const OldSel, NewSel: TSelectRows);
  procedure Reselection;
  procedure SelectionChanged(SelLen: Integer = 1);
  procedure ScrollTo(Row: Integer);
  procedure UpdateScrollBar;
  procedure InitLayout;
  procedure UpdateLayout;
  function GetColPerRow: Integer; inline;
  function GetMaxTopRow: Integer; inline;
  function GetRowCount: Integer; inline;
  function GetPageWidth: Integer; inline;
  function GetPageHeight: Integer; inline;
  function GetPageBottom: Integer; inline;
  function GetRowPerPage: Integer; inline;
  procedure OnTimer(Sender: TObject);
  procedure DrawBytes(RowStart, RowEnd: Integer);
  procedure DrawHzOfs;
  procedure DrawVtOfs(RowStart, RowEnd: Integer);
  procedure InvalidateRows(const Rows: TSelectRows);
  procedure SetInitialSize(Value: Integer);
  procedure SetColor(Index: Integer; Value: TColor);
protected
  procedure CreateWnd; override;
  procedure CreateParams(var Params: TCreateParams); override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  function MouseActivate(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer; HitTest: Integer): TMouseActivate; override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;
  procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  procedure Paint; override;
  procedure Resize; override;
  procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure AssignData(Data: Pointer; Count: Integer);
  procedure Clear;
  function GetSelectData(Ofs: Integer): Pointer;
  (* Custom Properties *)
  property Reselect: Boolean
      read FReselect write FReselect default True;
published
  property Align;
  property Anchors;
  property Color default clWindow;
  property ParentColor default False;
  (* Custom Properties *)
  property Highlight: TColor index 0 read FHighlight write SetColor;
  property HighlightText: TColor index 1 read FHighlightText write SetColor;
  property InitialSize: Integer
      read FInitialSize write SetInitialSize default 20000;
  property OffsetTextColor: TColor
      index 2 read FOfsTextColor write SetColor default clGray;
  (* Custom Events *)
  property OnSelectionChanged: TSelectionChangedEvent
      read FOnSelectionChanged write FOnSelectionChanged;
end;

//------------------------------------------------------------------------------
TPacket = type PByte;
(*
## Packet Information ##
    00 - Data-Length
    02 - Winsock Command
    04 - Time
    08 - Data
*)

//------------------------------------------------------------------------------
//** TPacketList **//
TPacketList = class(TCustomControl)
private
  FList: array of TPacket;
  FCount: Integer;
  FInitialSize: Integer;
  FCapacity: Integer;
  FIncrement: Integer;
  FTopIndex: Integer;
  FMaxTopIndex: Integer;
  FItemIndex: Integer;
  FItemHeight: Integer;
  FItemPerPage: Integer;
  FUpdating: Boolean;
  FMouseEnter: Boolean;
  FShowNewItem: Boolean;
  FCanScroll: Boolean;
  FHitTest: Integer;
  FOnSelChanged: TNotifyEvent;
  procedure DrawItem(Index: Integer; R: TRect);
  procedure InitFont;
  procedure ReleaseData;
  function GetItemPerPage: Integer; inline;
  function GetMaxTopIndex: Integer; inline;
  function IndexFromPos(X, Y: Integer): Integer;
  function ItemRect(Index: Integer): TRect;
  function IsVisItem(Index: Integer): Boolean;
  procedure InvalidateItem(Index: Integer);
  procedure UpdateLayout;
  function ScrollTo(Index: Integer): Integer;
  function ScrollIntoView(Index: Integer): Integer;
  procedure UpdateScrollBar;
  function GetItem(Index: Integer): TPacket;
  procedure SetItemIndex(Value: Integer);
  procedure SelectItem(Index: Integer);
  procedure SelectionChanged;
  procedure SetItemHeight(Value: Integer);
  procedure SetInitialSize(Value: Integer);
  procedure SetIncrement(Value: Integer);
  procedure SetShowNewItem(Value: Boolean);
protected
  procedure CreateParams(var Params: TCreateParams); override;
  procedure CreateWnd; override;
  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  function MouseActivate(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer; HitTest: Integer): TMouseActivate; override;
  procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  procedure Paint; override;
  procedure Resize; override;
  procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  procedure WMMouseleave(var Message: TMessage); message WM_MOUSELEAVE;
  procedure WMNcmouseleave(var Message: TMessage); message WM_NCMOUSELEAVE;
  procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
  procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
  procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
public
  constructor Create(AOwner: TComponent); override;
  destructor Destroy; override;
  procedure Add(Packet: TPacket);
  procedure Clear;
  procedure BeginUpdate;
  procedure EndUpdate;
  (* Custom Properties *)
  property Count: Integer read FCount;
  property Item[Index: Integer]: TPacket read GetItem; default;
  property ItemIndex: Integer read FItemIndex write SetItemIndex;
published
  property Align;
  property Anchors;
  property Color default clWindow;
  property ParentColor default False;
  (* Custom Properties *)
  property InitialSize: Integer
      read FInitialSize write SetInitialSize default 4096;
  property Increment: Integer
      read FIncrement write SetIncrement default 1024;
  property ShowNewItem: Boolean
      read FShowNewItem write SetShowNewItem default False;
  property ItemHeight: Integer
      read FItemHeight write SetItemHeight default 25;
  (* Custom Events *)
  property OnSelectionChanged: TNotifyEvent
      read FOnSelChanged write FOnSelChanged;
end;

//------------------------------------------------------------------------------
function GetTime32: Cardinal;
function TimeStr(Tm: Cardinal): String;

//------------------------------------------------------------------------------
const

(* COMMAND *)
CMD_SEND1 = 1;
CMD_RECV1 = 2;
CMD_SEND2 = 3;
CMD_RECV2 = 4;

//------------------------------------------------------------------------------
procedure Register;

implementation

uses uxSelectionFrame;

{$R YgpCxEx.res}

procedure Register;
begin
  RegisterComponents('YGP-CONTROLS',
      [
        TButtonEx, TPngButton, TLabelEx, THexView, TSelectInfo, TPacketList
      ]);
end;

//------------------------------------------------------------------------------
function CreateMask(Width: Integer; Height: Integer; Mask: Cardinal): TBitmap;
var
  Col, Row: Integer;
  PColor: PDWORD;
begin
  Result := TBitmap.Create;
  try
    Result.PixelFormat := pf32bit;
    Result.AlphaFormat := afDefined;
    Result.SetSize(Width, Height);
    for Row := 0 to Height - 1 do
    begin
      PColor := Result.ScanLine[Row];
      for Col := 0 to Width - 1 do
      begin
        PColor^ := Mask;
        Inc(PColor);
      end;
    end;
  except
    FreeAndNil(Result);
  end;
end;

//==============================================================================
//** TPacketList
//------------------------------------------------------------------------------
constructor TPacketList.Create(AOwner: TComponent);
begin
  inherited;
  FList := nil;
  FCapacity := 0;
  FInitialSize := 4096;
  FIncrement := 1024;
  FCount := 0;
  FItemHeight := 25;
  FTopIndex := 0;
  FMaxTopIndex := 0;
  FItemPerPage := 0;
  FItemIndex := -1;
  FShowNewItem := False;
  DoubleBuffered := True;
  ParentColor := False;
  Color := clWindow;
  InitFont;
  FCanScroll := False;
  SetBounds(0, 0, 200, 250);
end;
//------------------------------------------------------------------------------
destructor TPacketList.Destroy;
begin
  ReleaseData;
  FList := nil;
  inherited;
end;
//------------------------------------------------------------------------------
procedure TPacketList.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do Style := Style or WS_VSCROLL;
end;
//------------------------------------------------------------------------------
procedure TPacketList.CreateWnd;
begin
  inherited;
  ShowScrollBar(Handle, SB_VERT, False);
end;
//------------------------------------------------------------------------------
procedure TPacketList.InitFont;
begin
  with Font do
  begin
    Name := 'Courier New';
    Size := 10;
    Style := [];
    Charset := ANSI_CHARSET;
    Pitch := fpFixed;
    Color := clWindowText;
  end;
  Canvas.Font := Font;
end;
//------------------------------------------------------------------------------
procedure TPacketList.Add(Packet: TPacket);
var
  Index: Integer;
begin
  if FCount >= FCapacity then
  begin
    if FCapacity = 0 then
      FCapacity := FInitialSize
    else
      Inc(FCapacity, FIncrement);
    SetLength(FList, FCapacity);
  end;
  Index := FCount;
  FList[Index] := Packet;
  Inc(FCount);
  if not FUpdating then
  begin
    FMaxTopIndex := GetMaxTopIndex;
    UpdateScrollBar;
    InvalidateItem(Index);
    if FShowNewItem and (not FMouseEnter) then
      ScrollTo(FMaxTopIndex)
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.Clear;
begin
  ReleaseData;
  FCount := 0;
  FTopIndex := 0;
  FItemIndex := -1;
  Invalidate;
  SelectionChanged;
  UpdateScrollBar;
end;
//------------------------------------------------------------------------------
procedure TPacketList.BeginUpdate;
begin
  FUpdating := True;
end;
//------------------------------------------------------------------------------
procedure TPacketList.EndUpdate;
begin
  if FUpdating then
  begin
    FUpdating := False;
    FMaxTopIndex := GetMaxTopIndex;
    if FShowNewItem then FTopIndex := FMaxTopIndex;
    UpdateScrollBar;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.ReleaseData;
var
  i: Integer;
begin
  if FCount > 0 then
    for i := 0 to FCount - 1 do FreeMem(FList[i]);
end;
//------------------------------------------------------------------------------
procedure TPacketList.DrawItem(Index: Integer; R: TRect);
const
  T_CMD: array [0..1] of String = ('RECV', 'SEND');
  C_CMD: array [0..1] of TColor = ($007B511C, $002131C5);
var
  Packet: TPacket;
  Tm: String;     // Time string
  Cmd: Integer;   // Command
  Pkt: Word;      // Packet type
  Size: Integer;  // Packet size
  C: TColor;
  T: String;
begin
  Packet := FList[Index];
  Size := PWord(Packet + 0)^;
  Cmd := PWord(Packet + 2)^;
  Tm := TimeStr(PDWORD(Packet + 4)^);
  if Cmd < CMD_SEND2 then
    Pkt := PWord(Packet + 8)^
  else
    Pkt := PWord(Packet + 10)^;
  Cmd := Cmd and 1;
  T := Format('%.8u> %s %s[%.4X]%8d', [Index, Tm, T_CMD[Cmd], Pkt, Size]);
  C := C_CMD[Cmd];
  with Canvas do
  begin
    if Index = FItemIndex then
    begin
      Font.Color := clWhite;
      Brush.Color := GetHighLightColor(C, 30);
      FillRect(R);
    end
    else
    begin
      Brush.Color := Self.Color;
      Font.Color := C;
    end;
    Inc(R.Left, 8);
    DrawText(Handle, T, -1, R, DT_SINGLELINE or DT_VCENTER
        or DT_NOPREFIX or DT_NOCLIP)
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.Paint;
var
  Index, A, B: Integer;
  R: TRect;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(ClipRect);
    if FCount > 0 then
    begin
      A := FTopIndex + (ClipRect.Top div FItemHeight);
      B := FTopIndex + ((ClipRect.Bottom - 1) div FItemHeight);
      if B >= FCount then B := FCount - 1;
      R := ItemRect(A);
      Font := Self.Font;
      IntersectClipRect(Handle, 0, 0, ClientWidth, Height - 2);
      for Index := A to B do
      begin
        DrawItem(Index, R);
        R.Top := R.Bottom;
        Inc(R.Bottom, FItemHeight);
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.Resize;
begin
  inherited;
  UpdateLayout;
end;
//------------------------------------------------------------------------------
function TPacketList.IndexFromPos(X: Integer; Y: Integer): Integer;
begin
  Result := (Y div FItemHeight) + FTopIndex;
  if Result >= FCount then Result := -1;
end;
//------------------------------------------------------------------------------
function TPacketList.ItemRect(Index: Integer): TRect;
begin
  with Result do
  begin
    Left := 0;
    Top := (Index - FTopIndex) * FItemHeight;
    Right := ClientWidth;
    Bottom := Top + FItemHeight;
  end;
end;
//------------------------------------------------------------------------------
function TPacketList.GetMaxTopIndex: Integer;
begin
  Result := Max(FCount - FItemPerPage, 0);
end;
//------------------------------------------------------------------------------
function TPacketList.GetItemPerPage: Integer;
begin
  Result := (Height - 2) div FItemHeight
end;
//------------------------------------------------------------------------------
function TPacketList.IsVisItem(Index: Integer): Boolean;
var
  VisItemCount: Integer;
begin
  Result := (Index >= FTopIndex) and (Index < FCount);
  if Result then
  begin
    VisItemCount := ((Height - 2) + FItemHeight - 1) div FItemHeight;
    Dec(Index, FTopIndex);
    Result := (Index >= 0) and (Index < VisItemCount);
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.InvalidateItem(Index: Integer);
var
  R: TRect;
begin
  if IsVisItem(Index) then
  begin
    R := ItemRect(Index);
    InvalidateRect(Handle, R, False);
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.UpdateLayout;
var
  ItemPerPage: Integer;
begin
  ItemPerPage := GetItemPerPage;
  if ItemPerPage <> FItemPerPage then
  begin
    FItemPerPage := ItemPerPage;
    FMaxTopIndex := GetMaxTopIndex;
    if FTopIndex > FMaxTopIndex then FTopIndex := FMaxTopIndex;
    UpdateScrollBar;
  end;
end;
//------------------------------------------------------------------------------
function TPacketList.ScrollTo(Index: Integer): Integer;
begin
  Result := FTopIndex;
  if Index < 0 then
    Index := 0
  else if Index > FMaxTopIndex then
    Index := FMaxTopIndex;
  if Index <> Result then
  begin
    Result := Index;
    FTopIndex := Result;
    SetScrollPos(Handle, SB_VERT, Result, True);
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
function TPacketList.ScrollIntoView(Index: Integer): Integer;
var
  A, B: Integer;
begin
  A := FTopIndex;
  B := A + FItemPerPage;
  if Index < A then
    Result := ScrollTo(Index)
  else if Index >= B then
    Result := ScrollTo(Index - FItemPerPage + 1)
  else
    Result := FTopIndex;
end;
//------------------------------------------------------------------------------
procedure TPacketList.UpdateScrollBar;
var
  ScrollInfo: TScrollInfo;
  CanScroll: Boolean;
begin
  CanScroll := FCount > FItemPerPage;
  if CanScroll or (CanScroll <> FCanScroll) then
  begin
    with ScrollInfo do
    begin
      nMin := 0;
      if CanScroll then
        nMax := FCount - 1
      else
        nMax := -1;
      nPage := FItemPerpage;
      nPos := FTopIndex;
      fMask := SIF_POS or SIF_RANGE or SIF_PAGE;
      cbSize := SizeOf(TScrollInfo);
    end;
    SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
    FCanScroll := CanScroll;
  end;
end;
//------------------------------------------------------------------------------
function TPacketList.GetItem(Index: Integer): TPacket;
begin
  Result := FList[Index];
end;
//------------------------------------------------------------------------------
procedure TPacketList.SetItemIndex(Value: Integer);
begin
  if FItemIndex <> Value then SelectItem(Value);
end;
//------------------------------------------------------------------------------
procedure TPacketList.SelectItem(Index: Integer);
var
  OldIndex, OldTopIndex: Integer;
begin
  if Index <> FItemIndex then
  begin
    If Index < 0 then
    begin
      OldIndex := FItemIndex;
      FItemIndex := -1;
      InvalidateItem(OldIndex);
    end
    else
    begin
      OldTopIndex := FTopIndex;
      OldIndex := FItemIndex;
      FItemIndex := Index;
      if OldTopIndex = ScrollIntoView(Index) then
      begin
        InvalidateItem(OldIndex);
        InvalidateItem(Index);
      end;
    end;
    SelectionChanged;
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.SelectionChanged;
begin
  if Assigned(FOnSelChanged) then FOnSelChanged(Self);
end;
//------------------------------------------------------------------------------
procedure TPacketList.SetItemHeight(Value: Integer);
begin
  if (Value > 8) and (FItemHeight <> Value) then
  begin
    FItemHeight := Value;
    UpdateLayout;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.SetInitialSize(Value: Integer);
begin
  if (FList = nil) and (FInitialSize <> Value) and (FInitialSize > 0) then
    FInitialSize := Value;
end;
//------------------------------------------------------------------------------
procedure TPacketList.SetIncrement(Value: Integer);
begin
  if (Value > 0) and (FIncrement <> Value) then
    FIncrement := Value;
end;
//------------------------------------------------------------------------------
procedure TPacketList.SetShowNewItem(Value: Boolean);
begin
  if FShowNewItem <> Value then
  begin
    FShowNewItem := Value;
    if (FCount > 0) and (FItemPerPage > 0) then ScrollTo(FMaxTopIndex);
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.KeyDown(var Key: Word; Shift: TShiftState);
var
  MaxIndex: Integer;
begin
  inherited;
  MaxIndex := FCount - 1;
  if MaxIndex < 0 then Exit;
  case Key of
    VK_DOWN:
      if FItemIndex < 0 then
        SelectItem(FTopIndex)
      else if FItemIndex < MaxIndex then
        SelectItem(FItemIndex + 1);

    VK_UP:
      if FItemIndex < 0 then
        SelectItem(Min(FTopIndex + FItemPerPage - 1, MaxIndex))
      else if FItemIndex > 0 then
        SelectItem(FItemIndex - 1);

    VK_HOME: if FItemIndex <> 0 then SelectItem(0);

    VK_END: if FItemIndex <> MaxIndex then SelectItem(MaxIndex);

    VK_PRIOR:
      if FItemIndex < 0 then
        SelectItem(Min(FTopIndex + FItemPerPage - 1, MaxIndex))
      else if FItemIndex > 0 then
        SelectItem(Max(FItemIndex - FItemPerPage + 1, 0));

    VK_NEXT:
      if FItemIndex < 0 then
        SelectItem(FTopIndex)
      else if FItemIndex < MaxIndex then
        SelectItem(Min(FItemIndex + FItemPerPage - 1, MaxIndex));
  end;
end;
//------------------------------------------------------------------------------
function TPacketList.MouseActivate(Button: TMouseButton; Shift: TShiftState;
    X: Integer; Y: Integer; HitTest: Integer): TMouseActivate;
begin
  Result := inherited;
  FHitTest := HTCLIENT;
  if not Focused then SetFocus;
end;
//------------------------------------------------------------------------------
procedure TPacketList.MouseDown(Button: TMouseButton; Shift: TShiftState;
    X: Integer; Y: Integer);
var
  Index: Integer;
begin
  if Button = mbLeft then
  begin
    Index := IndexFromPos(X, Y);
    if Index <> -1 then SelectItem(Index);
  end;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMGetDlgCode(var Message: TWMNoParams);
begin
  inherited;
  message.Result := message.Result or DLGC_WANTARROWS;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMNCHitTest(var Message: TWMNCHitTest);
begin
  inherited;
  FHitTest := Message.Result;
  if not FMouseEnter then FMouseEnter := True;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMMouseleave(var Message: TMessage);
begin
  inherited;
  if FHitTest = HTCLIENT then FMouseEnter := False;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMNcmouseleave(var Message: TMessage);
begin
  inherited;
  if FHitTest <> HTCLIENT then FMouseEnter := False;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMMouseWheel(var Message: TWMMouseWheel);
begin
  if FCount > FItemPerPage then
    ScrollTo(FTopIndex - Message.WheelDelta div 120);
  Message.Result := 0;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMVScroll(var Message: TWMScroll);
var
  ScrollInfo: TScrollInfo;
begin
  case Message.ScrollCode of
    SB_LINEDOWN:
      ScrollTo(FTopIndex + 1);
    SB_LINEUP:
      ScrollTo(FTopIndex - 1);
    SB_THUMBPOSITION, SB_THUMBTRACK:
    begin
      ScrollInfo.fMask := SIF_ALL;
      GetScrollInfo(Handle, SB_VERT, ScrollInfo);
      ScrollTo(ScrollInfo.nTrackPos);
    end;
    SB_PAGEDOWN:
      ScrollTo(FTopIndex + FItemPerPage - 1);
    SB_PAGEUP:
      ScrollTo(FTopIndex - FItemPerPage + 1);
    SB_BOTTOM:
      ScrollTo(FMaxTopIndex);
    SB_TOP:
      ScrollTo(0);
  end;
  Message.Result := 0;
end;
//------------------------------------------------------------------------------
procedure TPacketList.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;


//==============================================================================
//** TLabelEx
//------------------------------------------------------------------------------
constructor TLabelEx.Create(AOwner: TComponent);
begin
  inherited;
  FPadding := 6;
end;
//------------------------------------------------------------------------------
procedure TLabelEx.AdjustBounds;
begin
  inherited;
  if AutoSize then Width := Width + FPadding + FPadding;
end;
//------------------------------------------------------------------------------
procedure TLabelEx.Paint;
const
  AL: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
  WW: array[Boolean] of Word = (0, DT_WORDBREAK);
var
  R, CalcRect: TRect;
  DrawFlags: Cardinal;
begin
  R := ClientRect;
  if Transparent then
    Canvas.Brush.Style := bsClear
  else
  begin
    Canvas.Brush.Color := Color;
    Canvas.Brush.Style := bsSolid;
    Canvas.FillRect(R);
  end;
  if FPadding <> 0 then InflateRect(R, -FPadding, 0);
  DrawFlags := DT_EXPANDTABS or WW[WordWrap] or AL[Alignment];
  if Layout <> tlTop then
  begin
    CalcRect := R;
    DoDrawText(CalcRect, DrawFlags or DT_CALCRECT);
    if Layout = tlBottom then
      OffsetRect(R, 0, R.Bottom - CalcRect.Bottom)
    else
      OffsetRect(R, 0, (R.Bottom - CalcRect.Bottom) shr 1);
  end;
  DoDrawText(R, DrawFlags);
end;
//------------------------------------------------------------------------------
procedure TLabelEx.SetPadding(Value: Integer);
begin
  if FPadding <> Value then
  begin
    FPadding := Value;
    Invalidate;
  end;
end;


//==============================================================================
//** THexView
//------------------------------------------------------------------------------
constructor THexView.Create(AOwner: TComponent);
begin
  inherited;
  FCurOfs := -1;
  FSelStart := -1;
  FSelLen := 0;
  FCapacity := 0;
  FInitialSize := 20000;
  FData := nil;
  FCount := 0;
  FRowCount := 0;
  FTopRow := 0;
  FMaxTopRow := 0;
  FCh := 0;
  InitFont;
  FHighlight := clHighlight;
  FHighlightText := clHighlightText;
  FOfsTextColor := clGray;
  InitTimer;
  ParentFont := False;
  ParentColor := False;
  Color := clWindow;
  ParentDoubleBuffered := False;
  DoubleBuffered := True;
  CreateStrTable;
  FCanScroll := False;
  FReselect := True;
  SetBounds(0, 0, 400, 250);
end;
//------------------------------------------------------------------------------
destructor THexView.Destroy;
begin
  FData := nil;
  FTimer.Free;
  inherited;
end;
//------------------------------------------------------------------------------
procedure THexView.AssignData(Data: Pointer; Count: Integer);
var
  SetDefault: Boolean;
begin
  if (Data <> nil) and (Count > 0) then
  begin
    FCount := Count;

    if Count > FCapacity then
    begin
      if (FCapacity = 0) and (FInitialSize >= Count) then
        FCapacity := FInitialSize
      else
        FCapacity := Count;
      SetLength(FData, FCapacity);
    end;

    CopyMemory(@FData[0], Data, Count);
    FRowCount := GetRowCount;
    FMaxTopRow := GetMaxTopRow;

    SetDefault := True;

    if (FSelLen > 0) and FReselect then
    begin
      Reselection;
      SetDefault := False;
    end;

    if SetDefault then
    begin
      FTopRow := 0;
      FCurOfs := -1;
      FSelStart := -1;
      FSelLen := 0;
    end;

    UpdateScrollBar;
    Invalidate;
    SelectionChanged;
  end;
end;
//------------------------------------------------------------------------------
function THexView.GetSelectData(Ofs: Integer): Pointer;
begin
  if (FSelLen > 0) and (Ofs >= 0) and (Ofs < FCount) then
    Result := @FData[Ofs]
  else
    Result := nil;
end;
//------------------------------------------------------------------------------
procedure THexView.Clear;
begin
  if FCount <> 0 then
  begin
    FCount := 0;
    FMaxTopRow := 0;
    Invalidate;
    ShowScrollBar(Handle, SB_VERT, False);
    SelectionChanged(0);
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.CreateWnd;
begin
  inherited;
  ShowScrollBar(Handle, SB_VERT, False);
end;
//------------------------------------------------------------------------------
procedure THexView.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do Style := Style or WS_VSCROLL;
end;
//------------------------------------------------------------------------------
procedure THexView.CreateStrTable;
var
  i: Integer;
  T: String;
begin
  for i := 0 to 255 do
  begin
    FHexStr[i] := Format('%.2X', [i]);
    T := string(StringOfChar(AnsiChar(i), 1));
    if TCharacter.IsControl(T[1]) then T := '.';
    FChrStr[i] := T;
  end;
end;
//------------------------------------------------------------------------------
function THexView.GetActivePane(X, Y: Integer): Integer;
begin
  Result := 0;
  if (FCount > 0) and (Y >= FHexRect.Top) and (Y < FHexRect.Bottom) then
  begin
    if X >= FChrRect.Left then
    begin
      if X < FChrRect.Right then Result := PANE_CHR;
    end
    else if X >= FHexRect.Left then
    begin
      if X < FHexRect.Right then Result := PANE_HEX;
    end;
  end;
end;
//------------------------------------------------------------------------------
function THexView.GetHexGrid(X: Integer; Y: Integer): TPoint;
begin
  Dec(X, FHexRect.Left);
  Dec(Y, FHexRect.Top);
  if X < 0 then
    X := (X div FBw) - 1
  else
    X := X div FBw;
  if Y < 0 then
    Y := (Y div FCh) - 1
  else
    Y := Y div FCh;
  Result := Point(X, Y);
end;
//------------------------------------------------------------------------------
function THexView.GetChrGrid(X: Integer; Y: Integer): TPoint;
begin
  Dec(X, FChrRect.Left);
  Dec(Y, FChrRect.Top);
  if X < 0 then
    X := (X div FCw) - 1
  else
    X := X div FCw;
  if Y < 0 then
    Y := (Y div FCh) - 1
  else
    Y := Y div FCh;
  Result := Point(X, Y);
end;
//------------------------------------------------------------------------------
function THexView.GetColPerRow: Integer;
begin
  Result := Min(64, (FPageWidth - 20) div (FCw + FBw));
end;
//------------------------------------------------------------------------------
function THexView.GetMaxTopRow: Integer;
begin
  Result := Max(FRowCount - FRowPerPage, 0);
end;
//------------------------------------------------------------------------------
function THexView.GetRowCount: Integer;
begin
  if FColPerRow <= 0 then
    Result := 0
  else
    Result := (FCount + (FColPerRow - 1)) div FColPerRow;
end;
//------------------------------------------------------------------------------
function THexView.GetPageWidth: Integer;
begin
  Result := Width - 8 - FHexRect.Left - GetSystemMetrics(SM_CXVSCROLL);
end;
//------------------------------------------------------------------------------
function THexView.GetPageHeight: Integer;
begin
  Result := Height - 2 - FHexRect.Top;
end;
//------------------------------------------------------------------------------
function THexView.GetPageBottom: Integer;
begin
  Result := FHexRect.Top + FPageHeight;
end;
//------------------------------------------------------------------------------
function THexView.GetRowPerPage: integer;
begin
  Result := Max(1, FPageHeight div FCh);
end;
//------------------------------------------------------------------------------
procedure THexView.InitFont;
begin
  with Font do
  begin
    Name := 'Courier New';
    Size := 10;
    Style := [];
    Charset := ANSI_CHARSET;
    Pitch := fpFixed;
    Color := clWindowText;
  end;
  Canvas.Font := Font;
end;
//------------------------------------------------------------------------------
procedure THexView.InitLayout;
var
  FontDim: TSize;
  ATop, ABottom: Integer;
begin
  FontDim := Canvas.TextExtent('X');
  with FontDim do
  begin
    FCw := cx + 4;
    FCh := cy;
    FBw := cx + cx + 6;
  end;
  with FHzOfsRect do
  begin
    Top := 4;
    Bottom := Top + FCh;
  end;
  ATop := FHzOfsRect.Bottom + 8;
  with FVtOfsRect do
  begin
    Left := 8;
    Top := ATop;
    Right := Left + FontDim.cx * 8;
  end;
  with FHexRect do
  begin
    Left := FVtOfsRect.Right + 20;
    Top := ATop;
  end;
  FPageWidth := GetPageWidth;
  FColPerRow := GetColPerRow;
  FPageHeight := GetPageHeight;
  FRowPerpage :=  GetRowPerPage;
  FMaxTopRow := GetMaxTopRow;
  ABottom := GetPageBottom;
  FVtOfsRect.Bottom := ABottom;
  with FHexRect do
  begin
    Right := Left + FBw * FColPerRow;
    Bottom := ABottom;
  end;
  with FChrRect do
  begin
    Left := FHexRect.Right + 20;
    Top := ATop;
    Right := Left + FCw * FColPerRow;
    Bottom := ABottom;
  end;
  with FHzOfsRect do
  begin
    Left := FHexRect.Left;
    Right := FHexRect.Right;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.InitTimer;
begin
  FTimer := TTimer.Create(Self);
  with FTimer do
  begin
    Enabled := False;
    Interval := 100;
    OnTimer := Self.OnTimer;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.DoSelect;
var
  Row, Col, Ofs: Integer;
  RowStart: Integer;
  MaxOfs, MaxRow: Integer;
  NewTopRow, BottomRow: Integer;
  AutoSelect: Boolean;
begin
  AutoSelect := False;
  NewTopRow := -1;
  RowStart := FSelStart div FColPerRow;
  MaxRow := FRowCount - 1;
  BottomRow := Min(FTopRow + FRowPerPage - 1, MaxRow);
  MaxOfs := FCount - 1;
  Row := FGrid.Y;
  Col := FGrid.X;
  if Row < 0 then
  begin
	  Row := Max(FTopRow - 1, 0);
		AutoSelect := True;
    if Col >= FColPerRow then NewTopRow := FTopRow - 1;
  end
  else
  begin
		Row := Min(Row + FTopRow, MaxRow);
		if Row > BottomRow then
		begin
      Row := BottomRow + 1;
			AutoSelect := True;
      if Col < 0 then NewTopRow := FTopRow + 1
		end
  end;
  if Col < 0 then
  begin
    Col := 0;
    if Row > RowStart then Dec(Col);
  end
  else if Col >= FColPerRow then
  begin
    Col := FColPerRow;
    if Row >= RowStart then Dec(Col);
  end;
  Ofs := Min(Row * FColPerRow + Col, MaxOfs);
  SelectTo(Ofs);
  if NewTopRow >= 0 then ScrollTo(NewTopRow);
  FTimer.Enabled := AutoSelect and ((FTopRow > 0) or (FTopRow < FMaxTopRow));
end;
//------------------------------------------------------------------------------
function THexView.GetSelectRows: TSelectRows;
var
  A, B: Integer;
begin
  Result.B := 0;
  if FSelLen > 0 then
  begin
    if FCurOfs >= FSelStart then
    begin
      A := FSelStart;
      B := FCurOfs;
    end
    else
    begin
      A := FCurOfs;
      B := FSelStart;
    end;
    Result.A := A div FColPerRow;
    Result.B := B div FColPerRow + 1;
  end;
end;
//------------------------------------------------------------------------------
function THexView.IsSelect(Ofs: Integer; out SelStart: Integer;
    out SelEnd: Integer): Boolean;
begin
  if FSelLen <= 0 then
    Result := False
  else
  begin
    if FCurOfs >= FSelStart then
    begin
      SelStart := FSelStart;
      SelEnd := FCurOfs;
      Result := (Ofs >= FSelStart) and (Ofs <= FCurOfs);
    end
    else
    begin
      SelStart := FCurOfs;
      SelEnd := FSelStart;
      Result := (Ofs >= FCurOfs) and (Ofs <= FSelStart);
    end;
  end;
end;
//------------------------------------------------------------------------------
function THexView.Select(Ofs: Integer): Boolean;
var
  OldSel, NewSel: TSelectRows;
  Row, TopRow: Integer;
  NotScroll: Boolean;
begin
  Result := (Ofs <> FCurOfs) or (FSelLen <> 1);
  if Result then
  begin
    Row := Ofs div FColPerRow;
    TopRow := FTopRow;
    if Row < FTopRow then
      TopRow := Row
    else if Row >= FTopRow + FRowPerPage then
      TopRow := Row - FRowPerPage + 1;
    NotScroll := TopRow = FTopRow;
    if NotScroll then OldSel := GetSelectRows;
    FSelStart := Ofs;
    FSelLen := 1;
    FCurOfs := Ofs;
    if NotScroll then
    begin
      NewSel := GetSelectRows;
      UpdateSelection(OldSel, NewSel);
    end
    else
      ScrollTo(TopRow);
    SelectionChanged
  end;
end;
//------------------------------------------------------------------------------
function THexView.SelectTo(Ofs: Integer): Boolean;
var
  SelLen: Integer;
  OldSel, NewSel: TSelectRows;
  Row, TopRow: Integer;
  NotScroll: Boolean;
begin
  if Ofs >= FSelStart then
    SelLen := Ofs - FSelStart
  else
    SelLen := FSelStart - Ofs;
  Inc(SelLen);
  Result := (Ofs <> FCurOfs) or (SelLen <> FSelLen);
  if Result then
  begin
    Row := Ofs div FColPerRow;
    TopRow := FTopRow;
    if Row < FTopRow then
      TopRow := Row
    else if Row >= FTopRow + FRowPerPage then
      TopRow := Row - FRowPerPage + 1;
    NotScroll := TopRow = FTopRow;
    if NotScroll then OldSel := GetSelectRows;
    FSelLen := SelLen;
    FCurOfs := Ofs;
    if NotScroll then
    begin
      NewSel := GetSelectRows;
      UpdateSelection(OldSel, NewSel);
    end
    else
      ScrollTo(TopRow);
    SelectionChanged
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.KeyDown(var Key: Word; Shift: TShiftState);
var
  Ofs, Row: Integer;
begin
  inherited;
  if FCount = 0 then Exit;
  case Key of
    VK_DOWN:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else if (FCurOfs div FColPerRow) < FRowCount - 1 then
      begin
        Ofs := Min(FCurOfs + FColPerRow, FCount - 1);
        SetSelection(Ofs, ssShift in Shift);
      end;
    end;

    VK_UP:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else if FCurOfs >= FColPerRow then
      begin
        Ofs := FCurOfs - FColPerRow;
        SetSelection(Ofs, ssShift in Shift);
      end;
    end;

    VK_LEFT:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else if FCurOfs > 0 then
      begin
        Ofs := FCurOfs - 1;
        SetSelection(Ofs, ssShift in Shift);
      end;
    end;

    VK_RIGHT:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else
      begin
        Ofs := FCurOfs + 1;
        if Ofs < FCount then
          SetSelection(Ofs, ssShift in Shift);
      end;
    end;

    VK_HOME:
    begin
      if FCurOfs < 0 then
        Select(0)
      else if FCurOfs > 0 then
        SetSelection(0, ssShift in Shift);
    end;

    VK_END:
    begin
      Ofs := FCount - 1;
      if FCurOfs < 0 then
        Select(Ofs)
      else if FCurOfs < Ofs then
        SetSelection(Ofs, ssShift in Shift);
    end;

    VK_PRIOR:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else
      begin
        Row := FCurOfs div FColPerRow;
        if Row > 0 then
        begin
          Row := Max(Row - FRowPerPage + 1, 0);
          Ofs := Row * FColPerRow + (FCurOfs mod FColPerRow);
          SetSelection(Ofs, ssShift in Shift);
        end;
      end;
    end;

    VK_NEXT:
    begin
      if FCurOfs < 0 then
        Select(FTopRow * FColPerRow)
      else
      begin
        Row := FCurOfs div FColPerRow;
        if Row < FRowCount - 1 then
        begin
          Row := Min(Row + FRowPerPage, FRowCount);
          Dec(Row);
          Ofs := Min(Row * FColPerRow + (FCurOfs mod FColPerRow),
              FCount - 1);
          SetSelection(Ofs, ssShift in Shift);
        end;
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
function THexView.MouseActivate(Button: TMouseButton; Shift: TShiftState;
    X: Integer; Y: Integer; HitTest: Integer): TMouseActivate;
begin
  Result := inherited;
  if not Focused then SetFocus;
end;
//------------------------------------------------------------------------------
procedure THexView.MouseDown(Button: TMouseButton; Shift: TShiftState;
    X: Integer; Y: Integer);
var
  Pt: TPoint;
  Ofs: Integer;
begin
  inherited;
  if Button = mbLeft then
  begin
    FActivePane := GetActivePane(X, Y);
    if FActivePane <> 0 then
    begin
      MouseCapture := True;
      if FActivePane = PANE_HEX then
      begin
        Pt.X := (X - FHexRect.Left) div FBw;
        GetGrid := GetHexGrid;
      end
      else
      begin
        Pt.X := (X - FChrRect.Left) div FCw;
        GetGrid := GetChrGrid;
      end;
      Pt.Y := (Y - FHexRect.Top) div FCh;
      Ofs := (Pt.Y + FTopRow) * FColPerRow + Pt.X;
      if Ofs < FCount then
      begin
        FGrid := Pt;
        FSelecting := True;
        SetSelection(Ofs, (ssShift in Shift) and (FSelStart >= 0));
      end;
    end
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.MouseMove(Shift: TShiftState; X: Integer; Y: Integer);
var
  Grid: TPoint;
begin
  inherited;
  if FSelecting then
  begin
    Grid := GetGrid(X, Y);
    if not PointsEqual(Grid, FGrid) then
    begin
      FTimer.Enabled := False;
      FGrid := Grid;
      DoSelect;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.MouseUp(Button: TMouseButton; Shift: TShiftState;
    X: Integer; Y: Integer);
begin
  inherited;
  FTimer.Enabled := False;
  FSelecting := False;
end;
//------------------------------------------------------------------------------
procedure THexView.UpdateSelection(const OldSel, NewSel: TSelectRows);
var
  R: TSelectRows;
begin
  if OldSel.B = 0 then
    InvalidateRows(NewSel)
  else if (OldSel.B < NewSel.A) or (OldSel.A > NewSel.B) then
  begin
    InvalidateRows(OldSel);
    if ((OldSel.B + 1) < NewSel.A) or ((NewSel.B + 1) < OldSel.A) then
      Update;
    InvalidateRows(NewSel);
  end
  else if (NewSel.A > OldSel.A) and (NewSel.B < OldSel.B) then
    InvalidateRows(OldSel)
  else if (NewSel.A = OldSel.A)
      and (NewSel.B = OldSel.B) then
  begin
    R := NewSel;
    if FCurOfs >= FSelStart then
      R.A := NewSel.B - 1
    else
      R.B := NewSel.A + 1;
    InvalidateRows(R);
  end
  else
  begin
    if OldSel.A < NewSel.A then
    begin
      R.A := OldSel.A;
      R.B := NewSel.A + 1;
      InvalidateRows(R);
    end;
    if NewSel.A < OldSel.A then
    begin
      R.A := NewSel.A;
      R.B := OldSel.A + 1;
      InvalidateRows(R);
    end;
    if OldSel.B > NewSel.B then
    begin
      R.A := NewSel.B - 1;
      R.B := OldSel.B;
      InvalidateRows(R);
    end;
    if NewSel.B > OldSel.B then
    begin
      R.A := OldSel.B - 1;
      R.B := NewSel.B;
      InvalidateRows(R);
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.Reselection;
var
  PSelStart, PSelEnd: PInteger;
begin
  if FCurOfs >= FSelStart then
  begin
    PSelStart := @FSelStart;
    PSelEnd := @FCurOfs
  end
  else
  begin
    PSelStart := @FCurOfs;
    PSelEnd := @FSelStart
  end;
  if PSelStart^ < FCount then
  begin
    if PSelEnd^ >= FCount then PSelEnd^ := FCount - 1;
    FSelLen := PSelEnd^ - PSelStart^ + 1;
  end
  else
  begin
    FTopRow := 0;
    PSelStart^ := -1;
    PSelEnd^ := -1;
    FSelLen := 0;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.SelectionChanged(SelLen: Integer = 1);
var
  Ofs: Integer;
begin
  if Assigned(FOnSelectionChanged) then
  begin
    if FCurOfs >= FSelStart then
      Ofs := FSelStart
    else
      Ofs := FCurOfs;
    if SelLen <> 0 then SelLen := FSelLen;
    FOnSelectionChanged(Self, Ofs, SelLen);
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.OnTimer(Sender: TObject);
begin
  DoSelect;
end;
//------------------------------------------------------------------------------
procedure THexView.DrawHzOfs;
var
  Col: Integer;
  T: String;
  R: TRect;
begin
  R := Bounds(FHzOfsRect.Left, FHzOfsRect.Top, FBw, FCh);
  for Col := 0 to FColPerRow - 1 do
  begin
    T := FHexStr[Col];
    DrawText(Canvas.Handle, T, -1, R, DT_SINGLELINE or DT_VCENTER
        or DT_CENTER or DT_NOPREFIX or DT_NOCLIP);
    R.Left := R.Right;
    Inc(R.Right, FBw);
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.DrawVtOfs(RowStart: Integer; RowEnd: Integer);
var
  Row: Integer;
  T: String;
  R: TRect;
  Ofs: Integer;
begin
  with R do
  begin
    Left := FVtOfsRect.Left;
    Top := FVtOfsRect.Top + (RowStart - FTopRow) * FCh;
    Right := FVtOfsRect.Right;
    Bottom := Top + FCh;
  end;
  Ofs := RowStart * FColPerRow;
  for Row := RowStart to RowEnd do
  begin
    T := Format('%.8X', [Ofs]);
    DrawText(Canvas.Handle, T, -1, R, DT_SINGLELINE or DT_VCENTER
        or DT_NOPREFIX or DT_NOCLIP);
    Inc(Ofs, FColPerRow);
    R.Top := R.Bottom;
    Inc(R.Bottom, FCh);
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.DrawBytes(RowStart: Integer; RowEnd: Integer);
var
  Row, Col: Integer;
  Value: Byte;
  Ofs, OfsSelStart, OfsSelEnd: Integer;
  CheckSelect, DrawSelect: Boolean;
  RH, RC: TRect;
  T: String;
begin
  with Canvas do
  begin
    Ofs := RowStart * FColPerRow;
    CheckSelect := FSelLen > 0;
    DrawSelect := False;
    Brush.Color := Color;
    Font.Color := Self.Font.Color;
    for Row := RowStart to RowEnd do
    begin
      with RH do
      begin
        Left := FHexRect.Left;
        Top := FHexRect.Top + (Row - FTopRow) * FCh;
        Right := Left + FBw;
        Bottom := Top + FCh;
      end;
      RC := Bounds(FChrRect.Left, RH.Top, FCw, FCh);
      for Col := 1 to FColPerRow do
      begin
        if DrawSelect then
        begin
          if Ofs > OfsSelEnd then
          begin
            DrawSelect := False;
            Brush.Color := Color;
            Font.Color := Self.Font.Color;
            CheckSelect := False;
          end
        end
        else if CheckSelect then
        begin
          DrawSelect := IsSelect(Ofs, OfsSelStart, OfsSelEnd);
          if DrawSelect then
          begin
            Brush.Color := FHighlight;
            Font.Color := FHighlightText;
            CheckSelect := False;
          end
        end;
        Value := FData[Ofs];
        (* Draw Hex *)
        if DrawSelect then FillRect(RH);
        T := FHexStr[Value];
        DrawText(Handle, T, -1, RH, DT_SINGLELINE or DT_VCENTER or DT_CENTER
            or DT_NOPREFIX or DT_NOCLIP);
        (* Draw Chr *)
        if DrawSelect then FillRect(RC);
        T := FChrStr[Value];
        DrawText(Handle, T, -1, RC, DT_SINGLELINE or DT_VCENTER or DT_CENTER
            or DT_NOPREFIX or DT_NOCLIP);
        Inc(Ofs);
        if Ofs = FCount then Exit;
        RH.Left := RH.Right;
        Inc(RH.Right, FBw);
        RC.Left := RC.Right;
        Inc(RC.Right, FCw);
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.Paint;
var
  RowStart, RowEnd: Integer;
  Top, Bottom: Integer;
begin
  with Canvas do
  begin
    Brush.Color := Color;
    FillRect(ClipRect);
    if FCount > 0 then
    begin
      Brush.Color := Color;
      Font.Color := FOfsTextColor;
      if RectVisible(Handle, FHzOfsRect) then DrawHzOfs;
      Top := FHexRect.Top;
      Bottom := FHexRect.Bottom;
      if ClipRect.Top > Top then Top := ClipRect.Top;
      if ClipRect.Bottom < Bottom then Bottom := ClipRect.Bottom;
      RowStart := (Top - FHexRect.Top) div FCh;
      RowEnd := (Bottom - FHexRect.Top - 1) div FCh;
      if (RowEnd >= RowStart) and (RowStart >= 0) then
      begin
        Inc(RowStart, FTopRow);
        Inc(RowEnd, FTopRow);
        if RowStart < FRowCount then
        begin
          IntersectClipRect(Handle, 0, 0, FChrRect.Right, FChrRect.Bottom);
          if RowEnd >= FRowCount then RowEnd := FRowCount - 1;
          if RectVisible(Handle, FVtOfsRect) then
            DrawVtOfs(RowStart, RowEnd);
          if RectVisible(Handle, FHexRect)
              or RectVisible(Handle, FChrRect) then
            DrawBytes(RowStart, RowEnd);
        end;
      end;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.InvalidateRows(const Rows: TSelectRows);
var
  A, B: Integer;
  R: TRect;
begin
  A := Max(Rows.A - FTopRow, 0);
  B := Min(Rows.B - FTopRow, FRowCount - FTopRow);
  if B > A then
  begin
    R.Left := FHexRect.Left;
    R.Right := FChrRect.Right;
    R.Top := FHexRect.Top + A * FCh;
    R.Bottom := FHexRect.Top + B * FCh;
    InvalidateRect(Handle, R, False);
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.Resize;
begin
  inherited;
  UpdateLayout;
end;
//------------------------------------------------------------------------------
procedure THexView.SetSelection(Ofs: Integer; Shift: Boolean);
begin
  if Shift then
    SelectTo(Ofs)
  else
    Select(Ofs);
end;
//------------------------------------------------------------------------------
procedure THexView.ScrollTo(Row: Integer);
begin
  if (Row <> FTopRow) and (Row >= 0) and (Row <= FMaxTopRow) then
  begin
    FTopRow := Row;
    SetScrollPos(Handle, SB_VERT, Row, True);
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.UpdateLayout;
var
  PageWidth: Integer;
  PageHeight: Integer;
  ColPerRow: Integer;
  RowPerPage: Integer;
  Bottom: Integer;
  LayoutChanged: Boolean;
begin
  if FCh = 0 then InitLayout;
  LayoutChanged := False;
  PageWidth := GetPageWidth;
  if PageWidth <> FPageWidth then
  begin
    FPageWidth := PageWidth;
    ColPerRow := GetColPerRow;
    if ColPerRow <> FColPerRow then
    begin
      FColPerRow := ColPerRow;
      FHexRect.Right := FHexRect.Left + FBw * ColPerRow;
      FChrRect.Left := FHexRect.Right + 20;
      FChrRect.Right := FChrRect.Left + FCw * ColPerRow;
      FHzOfsRect.Right := FHexRect.Right;
      FRowCount := GetRowCount;
      LayoutChanged := True;
    end;
  end;
  PageHeight := GetPageHeight;
  if PageHeight <> FPageHeight then
  begin
    FPageHeight := PageHeight;
    RowPerPage := GetRowPerPage;
    if RowPerPage <> FRowPerpage then
    begin
      FRowPerpage := RowPerPage;
      LayoutChanged := True;
    end;
    Bottom := GetPageBottom;
    FVtOfsRect.Bottom := Bottom;
    FHexRect.Bottom := Bottom;
    FChrRect.Bottom := Bottom;
  end;
  if LayoutChanged then
  begin
    FMaxTopRow := GetMaxTopRow;
    if FTopRow > FMaxTopRow then FTopRow := FMaxTopRow;
    UpdateScrollBar;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.UpdateScrollBar;
var
  ScrollInfo: TScrollInfo;
  CanScroll: Boolean;
begin
  CanScroll := FRowCount > FRowPerPage;
  if CanScroll or (CanScroll <> FCanScroll) then
  begin
    with ScrollInfo do
    begin
      nMin := 0;
      if CanScroll then
        nMax := FRowCount - 1
      else
        nMax := -1;
      nPage := FRowPerPage;
      nPos := FTopRow;
      fMask := SIF_POS or SIF_RANGE or SIF_PAGE;
      cbSize := SizeOf(TScrollInfo);
    end;
    SetScrollInfo(Handle, SB_VERT, ScrollInfo, True);
    FCanScroll := CanScroll;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.WMVScroll(var Message: TWMScroll);
var
  ScrollInfo: TScrollInfo;
begin
  case Message.ScrollCode of
    SB_LINEDOWN:
      ScrollTo(FTopRow + 1);
    SB_LINEUP:
      ScrollTo(FTopRow - 1);
    SB_THUMBPOSITION, SB_THUMBTRACK:
    begin
      ScrollInfo.fMask := SIF_ALL;
      GetScrollInfo(Handle, SB_VERT, ScrollInfo);
      ScrollTo(ScrollInfo.nTrackPos);
    end;
    SB_PAGEDOWN:
      ScrollTo(FTopRow + FRowPerPage - 1);
    SB_PAGEUP:
      ScrollTo(FTopRow - FRowPerPage + 1);
    SB_BOTTOM:
      ScrollTo(FMaxTopRow);
    SB_TOP:
      ScrollTo(0);
  end;
  Message.Result := 0;
end;
//------------------------------------------------------------------------------
procedure THexView.WMMouseWheel(var Message: TWMMouseWheel);
begin
  if FRowCount > FRowPerPage then
    ScrollTo(FTopRow - Message.WheelDelta div 120);
  Message.Result := 0;
end;
//------------------------------------------------------------------------------
procedure THexView.WMGetDlgCode(var Message: TWMNoParams);
begin
  inherited;
  message.Result := message.Result or DLGC_WANTARROWS;
end;
//------------------------------------------------------------------------------
procedure THexView.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;
//------------------------------------------------------------------------------
procedure THexView.SetColor(Index: Integer; Value: TColor);
var
  Changed: Boolean;
begin
  Changed := False;
  if Index = 0 then
  begin
    if FHighlight <> Value then
    begin
      FHighlight := Value;
      Changed := True;
    end;
  end
  else if Index = 1 then
  begin
    if FHighlightText <> Value then
    begin
      FHighlightText := Value;
      Changed := True;
    end;
  end
  else if FOfsTextColor <> Value  then
  begin
    FOfsTextColor := Value;
    Changed := True;
  end;
  if Changed and (FCount > 0) then
  begin
    if (Index = 3) or
        (
          (FSelLen > 0) and
          (FSelStart >= 0) and
          (FSelStart < FCount)
        ) then
      Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure THexView.SetInitialSize(Value: Integer);
begin
  if (FData = nil) and (Value >= 1024) and (FInitialSize <> Value) then
    FInitialSize := Value;
end;


//==============================================================================
//** TButtonEx
//------------------------------------------------------------------------------
constructor TButtonEx.Create(AOwner: TComponent);
begin
  inherited;
  FBorderColor := clBtnShadow;
  FFocusRectColor := clBtnShadow;
  FLumA := 10;
  FLumB := -10;
  FCanvas := TCanvas.Create;
  SetBounds(0, 0, 80, 22);
end;
//------------------------------------------------------------------------------
destructor TButtonEx.Destroy;
begin
  FCanvas.Free;
  inherited;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do Style := Style or BS_OWNERDRAW;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.DrawItem(const DrawItemStruct: TDrawItemStruct);
const
  DrawFlags = DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_NOPREFIX;
var
  IsDown, IsFocused: Boolean;
  Len, X, Y: Integer;
  R: TRect;
  C, CA, CB: TColor;
  Mask: TBitmap;
begin
  R := ClientRect;
  FCanvas.Font := Font;
  with DrawItemStruct do
  begin
    FCanvas.Handle := hDC;
    IsDown := itemState and ODS_SELECTED <> 0;
    IsFocused := itemState and ODS_FOCUS <> 0;
  end;
  if IsFocused then
    FCanvas.Brush.Color := FFocusRectColor
  else
    FCanvas.Brush.Color := FBorderColor;
  FCanvas.FrameRect(R);
  InflateRect(R, -1, -1);
  C := Color;
  if IsDown then
  begin
    FCanvas.Brush.Color := C;
    FCanvas.FillRect(R);
  end
  else
  begin
    if MouseInControl then
      C:= ColorAdjustLuma(C, 10, True);
    CA := C;
    if FLumA <> 0 then
      CA := ColorAdjustLuma(CA, FLumA, True);
    CB := C;
    if FLumB <> 0 then
      CB := ColorAdjustLuma(CB, FLumB, True);
    GradientFillCanvas(FCanvas, CA, CB, R, gdVertical);
  end;
  if Enabled then
  begin
    if Default then
    begin
      X := 8;
      Y := (R.Bottom - R.Top) div 2 - 2;
      FCanvas.Pen.Color := Font.Color;
      Len := 7;
      while Len > 0 do
      begin
        FCanvas.MoveTo(X, Y);
        FCanvas.LineTo(X, Y + Len);
        Inc(X); Inc(Y);
        Dec(Len, 2);
      end;
      X := R.Right - 8;
      Y := (R.Bottom - R.Top) div 2 - 2;
      Len := 7;
      while Len > 0 do
      begin
        FCanvas.MoveTo(X, Y);
        FCanvas.LineTo(X, Y + Len);
        Dec(X); Inc(Y);
        Dec(Len, 2);
      end;
    end;
  end;
  Len := Length(Caption);
  if Len > 0 then
  begin
    FCanvas.Brush.Style := bsClear;
    InflateRect(R, 10, 4);
    if Enabled then
      DrawText(FCanvas.Handle, Caption, Len, R, DrawFlags)
    else
    begin
      OffsetRect(R, 1, 1);
      C := Color;
      FCanvas.Font.Color := ColorAdjustLuma(C, 40, True);
      DrawText(FCanvas.Handle, Caption, Len, R, DrawFlags);
      OffsetRect(R, -1, -1);
      FCanvas.Font.Color := ColorAdjustLuma(C, -80, True);
      DrawText(FCanvas.Handle, Caption, Len, R, DrawFlags);
    end
  end;
  if IsDown then
  begin
    Mask := CreateMask(R.Right - R.Left, R.Bottom - R.Top, $14000000);
    if Mask <> nil then
    begin
      FCanvas.Draw(R.Left, R.Top, Mask);
      Mask.Free;
    end;
  end;
  FCanvas.Handle := 0;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.MouseMove(Shift: TShiftState; X: Integer; Y: Integer);
begin
  inherited;
  if ssLeft in Shift then
  begin
    if not PtInRect(ClientRect, Point(X, Y)) then
      Perform(CM_MOUSELEAVE, 0, 0);
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.SetBorderColor(Value: TColor);
begin
  if FBorderColor <> Value then
  begin
    FBorderColor := Value;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.SetButtonStyle(ADefault: Boolean);
begin
  if ADefault <> IsDefault then
  begin
    IsDefault := ADefault;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.SetFocusRectColor(Value: TColor);
begin
  if FFocusRectColor <> Value then
  begin
    FFocusRectColor := Value;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.SetLum(Index: Integer; Value: Integer);
begin
  if Index = 0 then
  begin
    if FLumA <> Value then
    begin
      FLumA := Value;
      Invalidate;
    end;
  end
  else
  begin
    if FLumB <> Value then
    begin
      FLumB := Value;
      Invalidate;
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.CMEnabledchanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.CMMouseenter(var Message: TMessage);
begin
  inherited;
  if (not MouseInControl) and (not (csDesigning in ComponentState)) then
  begin
    MouseInControl := True;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.CMMouseleave(var Message: TMessage);
begin
  inherited;
  if MouseInControl then
  begin
    MouseInControl := False;
    Invalidate;
  end;
end;
//------------------------------------------------------------------------------
procedure TButtonEx.CNDrawitem(var Message: TWMDrawItem);
begin
  DrawItem(Message.DrawItemStruct^);
end;
//------------------------------------------------------------------------------
procedure TButtonEx.WMLButtonDblClk(var Message: TWMMouse);
begin
  Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Word(Message.XPos)
      or (Word(Message.YPos) shr 16)));
end;
//------------------------------------------------------------------------------
procedure TButtonEx.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;


//==============================================================================
//** TPngButton
//------------------------------------------------------------------------------
constructor TPngButton.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle - [csSetCaption];
  FPng := TPngImage.Create;
  SetBounds(0, 0, 22, 22);
end;
//------------------------------------------------------------------------------
destructor TPngButton.Destroy;
begin
  FPng.Free;
  inherited;
end;
//------------------------------------------------------------------------------
procedure TPngButton.DrawItem(const DrawItemStruct: tagDRAWITEMSTRUCT);
var
  IsDown, IsFocused: Boolean;
  R, Rx: TRect;
  Mask: TBitmap;
begin
  R := ClientRect;
  with DrawItemStruct do
  begin
    FCanvas.Handle := hDC;
    IsDown := itemState and ODS_SELECTED <> 0;
    IsFocused := itemState and ODS_FOCUS <> 0;
  end;
  if IsFocused then
    FCanvas.Brush.Color := FFocusRectColor
  else
    FCanvas.Brush.Color := FBorderColor;
  FCanvas.FillRect(R);
  InflateRect(R, -1, -1);
  FCanvas.Brush.Color := Color;
  FCanvas.FillRect(R);
  IntersectClipRect(FCanvas.Handle, R.Left, R.Top, R.Right, R.Bottom);
  Rx := CenteredRect(R, Rect(0, 0, FPng.Width, FPng.Height));
  FCanvas.Draw(Rx.Left, Rx.Top, FPng);
  if IsDown then
  begin
    Mask := CreateMask(R.Right - R.Left, R.Bottom - R.Top, $14000000);
    if Mask <> nil then
    begin
      FCanvas.Draw(R.Left, R.Top, Mask);
      Mask.Free;
    end;
  end;
  FCanvas.Handle := 0;
end;
//------------------------------------------------------------------------------
procedure TPngButton.LoadRes;
var
  Res: String;
begin
  if FRes = '' then
    FPng.Assign(nil)
  else
  begin
    Res := FRes;
    if not Enabled then Res := Res + '_D';
    try
      FPng.LoadFromResourceName(HInstance, Res);
      Invalidate;
    except
      //FPng.Assign(nil);
    end;
  end;
end;
//------------------------------------------------------------------------------
procedure TPngButton.SetRes(Value: string);
begin
  if FRes <> Value then
  begin
    FRes := Value;
    LoadRes;
  end;
end;
//------------------------------------------------------------------------------
procedure TPngButton.CMEnabledchanged(var Message: TMessage);
begin
  inherited;
  LoadRes;
end;


//------------------------------------------------------------------------------
const

TIME1970: UInt64 = $019DB1DED53E8000; // Time Since 1970

//------------------------------------------------------------------------------
function GetTime32: Cardinal;
var
  T: UInt64;
begin
  GetSystemTimeAsFileTime(TFileTime(T));
  T := (T - TIME1970) div 10000000;
  Result := Cardinal(T);
end;
//------------------------------------------------------------------------------
function TimeStr(Tm: Cardinal): String;
var
  LocalTime: TSystemTime;
  LocalFileTime: TFileTime;
  T: UInt64;
begin
  T := Tm;
  T := (T * 10000000) + TIME1970;
  FileTimeToLocalFileTime(TFileTime(T), LocalFileTime);
  FileTimeToSystemTime(LocalFileTime, LocalTime);
  with LocalTime do
    Result := Format('%.2d:%.2d:%.2d', [wHour, wMinute, wSecond]);
end;

end.
